home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / scrbas.arc / DEMO.BAS < prev    next >
BASIC Source File  |  1987-01-02  |  3KB  |  125 lines
  1.       REM INCLUDE$: 'LISTING.BAS'
  2.       DEFINT A-Z
  3.  
  4.       REM $INCLUDE: 'COMDIM.BAS'
  5.       DIM ORFLD$(20)
  6.  
  7.       REM $INCLUDE: 'SHARED.BAS'
  8.       COMMON SHARED ORFLD$()
  9.  
  10.       REM $INCLUDE: 'COMDEF.BAS'
  11.  
  12.  
  13.  
  14. REM   Define screen field headings.
  15.  
  16.       DIS$(10)="05,03,REV,ACCOUNT #"
  17.       DIS$(11)="05,14,REV,  P.O. #  "
  18.       DIS$(12)="05,26,REV,SHIP TO #"
  19.       DIS$(13)="08,02,REV,ITEM #"
  20.       DIS$(14)="08,09,REV,  CATALOG  #  "
  21.       DIS$(15)="08,24,REV,VENDOR"
  22.       DIS$(16)="08,31,REV,   DESCRIPTION/COMMENT    "
  23.       DIS$(17)="08,58,REV,UM"
  24.       DIS$(18)="08,61,REV, ORD QTY "
  25.       DIS$(19)="08,71,REV,  PRICE  "
  26.  
  27. REM   Define screen input fields.
  28.  
  29.       INP$(1)="06,05,NUM,5,NO,ACCT"
  30.       INP$(2)="06,14,ALP,10,YES,PO"
  31.       INP$(3)="06,29,NUM,3,YES,SHIPTO"
  32.       INP$(4)="09,02,NUM!NODEF,6,NO,ITEM"
  33.       INP$(5)="09,09,ALP,14,NO,CAT"
  34.       INP$(6)="09,24,ALP,6,NO,VEND"
  35.       INP$(7)="09,31,ALP,26,YES,DESC"
  36.       INP$(8)="09,58,ALP!FIX,2,YES,UM"
  37.       INP$(9)="09,61,NUM!DEC,9,NO,QTY"
  38.       INP$(10)="09,71,NUM!DEC,9,YES,PRICE"
  39.  
  40.  
  41.  
  42.  
  43. REM   Display field headings.
  44.  
  45.       HEADS$="10,11,12,13,14,15,16,17,18,19"
  46.       CALL DISHEADS (HEADS$)
  47.  
  48.       EDITMODE=NO
  49.  
  50. ADD.HEADER:
  51.       EXITSUB=NO
  52.  
  53. REM   Display function key definitions.
  54.  
  55.       FUNC$=",,,Exit"
  56.       CALL FUNCTIONS (FUNC$)
  57.  
  58. ADD.HEADER.LOOP:
  59.  
  60.       CLRF$="1,2,3"
  61.       INPS$="1,2,3"
  62.       FLDS$="1,2,3"
  63.       VOID$="6,5,31"
  64.       CALL GETFIELDS (CLRF$,INPS$,FLDS$,VOID$)
  65.       IF EXITSUB  = YES THEN END
  66.       IF KY       = ESC THEN GOTO ADD.HEADER.LOOP
  67.  
  68. REM   Display function key definitions.
  69.  
  70.       FUNC$=",,,End order"
  71.       CALL FUNCTIONS (FUNC$)
  72.  
  73. ADD.DETAIL:
  74.       CLRF$="4,5,6,7,8,9,10"
  75.       INPS$="4,5,6,7,8,9,10"
  76.       FLDS$="4,5,6,7,8,9,10"
  77.       VOID$="9,2,79"
  78.       CALL GETFIELDS (CLRF$,INPS$,FLDS$,VOID$)
  79.       IF EXITSUB  = YES THEN GOTO ADD.HEADER
  80.       IF KY       = ESC THEN GOTO ADD.DETAIL
  81.  
  82.       GOTO ADD.DETAIL
  83.  
  84.  
  85.  
  86. SUB GETFIELDS (CLRF$,INPS$,FLDS$,VOID$) STATIC
  87.       EXITSUB=NO
  88.       IF CLRF$<>"" THEN CALL CLEARFIELDS (CLRF$)
  89.       CALL LODWK1 (INPS$,I)
  90.       CALL LODWK2 (FLDS$,F)
  91.       IF I > F THEN N=WRK1%(I) : I=I-1 ELSE N=1
  92.       WHILE N<=I
  93.       F$=ORFLD$(WRK2%(N))
  94.       CALL ACCEPT (INP$((WRK1%(N))),F$)
  95.       IF KY = F4                     THEN EXITSUB=YES : EXIT SUB
  96.       IF KY = F5                     THEN DATSW=YES
  97.       IF KY = CTRL.LF                THEN N=N+(N>1)
  98.       IF KY = CTRL.RT                THEN N=N-(N<I)
  99.       IF KY = ESC AND VOID$<>""      THEN EN=106 : CALL DISERR (EN,ER$) : CALL CLRLIN (VOID$) : EXIT SUB
  100.       IF KY = 0                      THEN LSET ORFLD$(WRK2%(N)) = F$ : N=N+1
  101.       WEND
  102. END SUB
  103.  
  104. SUB CLRLIN (LIN$) STATIC
  105.       CALL LODWK2 (LIN$,F)
  106.       LOCATE WRK2%(1),WRK2%(2) : COLOR 7,0 : PRINT SPC((WRK2%(3)-WRK2%(2))+1);
  107. END SUB
  108.  
  109. SUB CLEARFIELDS (FLDS$) STATIC
  110.       CALL LODWK2 (FLDS$,F)
  111.       FOR N = 1 TO F
  112.       LSET ORFLD$(WRK2%(N))=""
  113.       NEXT N
  114. END SUB
  115.  
  116. SUB DISHEADS (HEADS$) STATIC
  117.       CALL LODWK1 (HEADS$,I)
  118.       BUMP=0
  119.       N=1
  120.       WHILE N<=I
  121.       CALL DISPLAY (DIS$((WRK1%(N))),NULL$,BUMP)
  122.       N=N+1
  123.       WEND
  124. END SUB
  125.